home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / scn_savr / topsourc / top.bas < prev    next >
Encoding:
BASIC Source File  |  1995-09-24  |  4.7 KB  |  136 lines
  1. 'Declarations
  2. Option Explicit
  3.  
  4. Global TwipsPerPixel As Single
  5.  
  6. Global picCount%
  7. Global FirstTime%
  8.  
  9. Global Const SWP_NOSIZE = 1
  10. Global Const SWP_NOMOVE = 2
  11. Global Const SPI_SETSCREENSAVEACTIVE = 17
  12.  
  13. Global Const SRCCOPY = &HCC0020
  14. Global Const SRCERASE = &H440328
  15. Global Const SRCINVERT = &H660046
  16. Global Const SRCAND = &H8800C6
  17. Global Const SRCPAINT = &HEE0086
  18. Global Const NOTSRCCOPY = &H330008
  19. Global Const NOTSRCERASE = &H1100A6
  20. Global Const MERGECOPY = &HC000CA
  21. Global Const MERGEPAINT = &HBB0226
  22. Global Const PATCOPY = &HF00021
  23. Global Const PATPAINT = &HFB0A09
  24. Global Const PATINVERT = &H5A0049
  25. Global Const DSTINVERT = &H550009
  26. Global Const BLACKNESS = &H42&
  27. Global Const WHITENESS = &HFF0062
  28.  
  29. Type lrect
  30.     Left As Integer
  31.     Top As Integer
  32.     right As Integer
  33.     bottom As Integer
  34. End Type
  35.  
  36. Declare Sub SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
  37. Declare Function SystemParametersInfo Lib "User" (ByVal uAction As Integer, ByVal uparam As Integer, lpvParam As Any, ByVal fuWinIni As Integer) As Integer
  38. Declare Function GetDesktopWindow Lib "user" () As Integer
  39. Declare Function GetDC Lib "user" (ByVal hWnd%) As Integer
  40. Declare Function BitBlt Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal xSrc%, ByVal ySrc%, ByVal dwRop&) As Integer
  41. Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
  42. Declare Sub GetWindowRect Lib "User" (ByVal hWnd%, lpRect As lrect)
  43. Declare Function ShowCursor Lib "User" (ByVal bShow As Integer) As Integer
  44.  
  45. Sub CaptureDesktop ()
  46.     
  47.     Dim winSize As lrect
  48.     Dim hSourceDC%, hSourceWnd%, hDestDC%, dwRop&
  49.     Dim nWidth%, nHeight%, dummy%
  50.     
  51.     'Get a handle to the Desktop's DC (device context)
  52.     hSourceWnd% = GetDesktopWindow()
  53.     hSourceDC% = GetDC(hSourceWnd%)
  54.     
  55.     'Get the size in pixels of the actual screen
  56.     Call GetWindowRect(hSourceWnd%, winSize)
  57.     nWidth% = winSize.right             ' Units in pixels.
  58.     nHeight% = winSize.bottom           ' Units in pixels.
  59.     
  60.     'Get handle to the destination picture box
  61.     hDestDC% = frmMain.picSaver.hDC
  62.     
  63.     'Make sure picture box is the same size as the desktop (screen)
  64.     frmMain.picSaver.Top = 0
  65.     frmMain.picSaver.Left = 0
  66.     frmMain.picSaver.Width = (nWidth% + 1) * Screen.TwipsPerPixelX
  67.     frmMain.picSaver.Height = (nHeight% + 1) * Screen.TwipsPerPixelY
  68.     
  69.     'Copy (capture) entire desktop to the picture box
  70.     dwRop& = SRCCOPY
  71.     dummy% = BitBlt(hDestDC%, 0, 0, nWidth%, nHeight%, ByVal hSourceDC%, 0, 0, dwRop&)
  72.     
  73.     'Make sure we release the desktop's DC to windows
  74.     dummy% = ReleaseDC(hSourceWnd%, hSourceDC%)
  75.  
  76.     'Make sure we can draw onto the picture box
  77.     frmMain.picSaver.AutoRedraw = False
  78.     
  79. End Sub
  80.  
  81. Sub ExitNice ()
  82.     
  83.     'Make sure we restore things back to the
  84.     'way they were before we started
  85.  
  86.     Dim dummy%
  87.  
  88.     'Restore the cursor
  89.     dummy% = ShowCursor(True)
  90.     
  91.     'Tell windows our screensaver is ending
  92.     dummy% = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 1, ByVal 0&, 0)
  93.     End
  94.  
  95. End Sub
  96.  
  97. Sub Main ()
  98.  
  99.     Dim dummy%
  100.     Dim msg$
  101.     
  102.     'Windows passes a command line argument to know
  103.     'we should show the configuration form for our
  104.     'screensaver
  105.     
  106.     'You may force it by using Project options in VB
  107.  
  108.     Select Case Command$
  109.         Case "/c", "/C"
  110.             'Configuration form would be loaded here
  111.             msg$ = "SPINNING TOP SCREEN SAVER"
  112.             msg$ = msg$ + Chr$(10) + Chr$(10)
  113.             msg$ = msg$ + "Software design by FXLP" + Chr$(10) + Chr$(10)
  114.             msg$ = msg$ + "Source code available upon request." + Chr$(10) + Chr$(10)
  115.             msg$ = msg$ + "Inquiries for custom software:" + Chr$(10) + "74052.2417@COMPUSERVE.COM"
  116.             msg$ = msg$ + Chr$(10) + Chr$(10)
  117.             msg$ = msg$ + "No warranties of any kind provided with this demo."
  118.             MsgBox msg$, 64, "Spinning Top"
  119.         Case Else
  120.             'Tell windows our screen saver is starting
  121.             dummy% = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 0, ByVal 0&, 0)
  122.             Load frmMain
  123.             'Capture the screen so we may draw onto a copy of the desktop
  124.             'and not the desktop itself
  125.             CaptureDesktop
  126.             'Show main screen
  127.             frmMain.Show
  128.             'Avoid main form from being moved or resized
  129.             SetWindowPos frmMain.hWnd, -1, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
  130.             'Make sure everything's in place, so we let windows refresh
  131.             dummy% = DoEvents()
  132.     End Select
  133.  
  134. End Sub
  135.  
  136.